home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / MacInterface / structure.icl < prev    next >
Encoding:
Modula Implementation  |  1996-02-22  |  3.6 KB  |  106 lines  |  [TEXT/3PRM]
  1. implementation module structure;
  2.  
  3. import mac_types;
  4.  
  5. ::    Structure :== (!Handle,!Ptr);
  6.  
  7. DereferenceHandle :: !Handle !Toolbox -> (!Ptr,!Toolbox);
  8. DereferenceHandle h tb = (DereferenceHandle1 h,tb);
  9.  
  10. DereferenceHandle1 :: !Handle -> Ptr;
  11. DereferenceHandle1 h = code (h=D0)(pointer=D0){
  12.     instruction 0x2040    ||    move.l    d0,a0
  13.     instruction 0x2010    ||    move.l    (a0),d0
  14. };
  15.  
  16. HandleToStructure :: !Handle -> Structure;
  17. HandleToStructure h = code (h=D0)(new_h=D1,pointer=D0){
  18.     instruction 0x2200    ||    move.l    d0,d1
  19.     instruction 0x2040    ||    move.l    d0,a0
  20.     instruction 0x2010    ||    move.l    (a0),d0
  21. };
  22.  
  23. Append_long :: !Structure !Int !Toolbox -> (!Structure,!Toolbox);
  24. Append_long hp l tb = (AppendLong hp l,tb);
  25.  
  26. AppendLong :: !Structure !Int -> Structure;
  27. AppendLong  (h,p) l = code (h=D2, p=D1, l=D0)(new_h=D1, new_p=D0){
  28.     instruction 0x2041    ||    move.l    d1,a0
  29.     instruction 0x20C0    ||    move.l    d0,(a0)+
  30.     instruction 0x2008    ||    move.l    a0,d0
  31.     instruction 0x2202    ||    move.l    d2,d1
  32. };
  33.  
  34. Append_word :: !Structure !Int !Toolbox -> (!Structure,!Toolbox);
  35. Append_word hp w tb = (AppendWord hp w,tb);
  36.  
  37. AppendWord :: !Structure !Int -> Structure;
  38. AppendWord (h,p) w = code (h=D2, p=D1, w=D0) (new_h=D1, new_p=D0){
  39.     instruction 0x2041    ||    move.l    d1,a0
  40.     instruction 0x30C0    ||    move.w    d0,(a0)+
  41.     instruction 0x2008    ||    move.l    a0,d0
  42.     instruction 0x2202    ||    move.l    d2,d1
  43. };
  44.  
  45. Append_byte :: !Structure !Int !Toolbox -> (!Structure,!Toolbox);
  46. Append_byte hp b tb = (AppendByte hp b,tb);
  47.  
  48. AppendByte :: !Structure !Int -> Structure;
  49. AppendByte (h,p) b = code (h=D2, p=D1, b=D0) (new_h=D1, new_p=D0){
  50.     instruction 0x2041    ||    move.l    d1,a0
  51.     instruction 0x10C0    ||    move.b    d0,(a0)+
  52.     instruction 0x2008    ||    move.l    a0,d0
  53.     instruction 0x2202    ||    move.l    d2,d1
  54. };
  55.  
  56. Append_zero_and_rect :: !Structure !Rect !Toolbox -> (!Structure,!Toolbox);
  57. Append_zero_and_rect hp rect tb = (Append_zero_and_rect1 hp rect,tb);
  58.  
  59. Append_zero_and_rect1 :: !Structure !Rect -> Structure;
  60. Append_zero_and_rect1 (h,p) (left,top,right,bottom) = code (h=D5, p=D4, left=D3, top=D2, right=D1, bottom=D0)(new_h=D1, new_p=D0){
  61.     instruction 0x2044    ||    move.l    d4,a0
  62.     instruction 0x4298    ||    clr.l    (a0)+
  63.     instruction 0x30C2    ||    move.w    d2,(a0)+
  64.     instruction 0x30C3    ||    move.w    d3,(a0)+
  65.     instruction 0x30C0    ||    move.w    d0,(a0)+
  66.     instruction 0x30C1    ||    move.w    d1,(a0)+
  67.     instruction 0x2008    ||    move.l    a0,d0
  68.     instruction 0x2205    ||    move.l    d5,d1         
  69. };
  70.  
  71. Append_string_and_align :: !Structure !{#Char} !Toolbox -> (!Structure,!Toolbox);
  72. Append_string_and_align hp string tb = (Append_string_and_align1 hp string,tb);
  73.  
  74. Append_string_and_align1 :: !Structure !{#Char} -> Structure;
  75. Append_string_and_align1 (h,p) string = code (h=D1, p=D0, string=A0) (new_h=D1, new_p=D0){
  76.     instruction 0x5E88    ||    addq.l    #7,a0
  77.     instruction 0x2240    ||    move.l    d0,a1
  78.     instruction 0x7400    ||    moveq    #0,d2
  79.     instruction 0x1418    ||    move.b    (a0)+,d2
  80.     instruction 0x12C2    ||    move.b    d2,(a1)+
  81.     instruction 0x6002    ||    bra.s    l2
  82.     instruction 0x12D8    ||    l1: move.b    (a0)+,(a1)+
  83.     instruction 0x51CA    
  84.     instruction 0xFFFC    ||    l2: dbra    d2,l1
  85.     instruction 0x2009    ||    move.l    a1,d0
  86.     instruction 0x5280    ||    addq.l    #1,d0
  87.     instruction 0x0880
  88.     instruction 0x0000    ||    bclr    #0,d0
  89. };
  90.  
  91. Append_string :: !Structure !{#Char} !Toolbox -> (!Structure,!Toolbox);
  92. Append_string hp string tb = (AppendString hp string,tb);
  93.  
  94. AppendString :: !Structure !{#Char} -> Structure;
  95. AppendString (h,p) string = code (h=D1, p=D0, string=A0) (new_h=D1, new_p=D0){
  96.     instruction 0x5E88    ||    addq.l    #7,a0
  97.     instruction 0x2240    ||    move.l    d0,a1
  98.     instruction 0x7400    ||    moveq    #0,d2
  99.     instruction 0x1418    ||    move.b    (a0)+,d2
  100.     instruction 0x6002    ||    bra.s    l2
  101.     instruction 0x12D8    ||    l1: move.b    (a0)+,(a1)+
  102.     instruction 0x51CA    
  103.     instruction 0xFFFC    ||    l2: dbra    d2,l1
  104.     instruction 0x2009    ||    move.l    a1,d0
  105. };
  106.